home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Marlais / Marlais 0.5.9-portable sources / dylan.l < prev    next >
Encoding:
Lex Description  |  1995-03-15  |  19.5 KB  |  860 lines  |  [TEXT/ttxt]
  1. %{ /*  Emacs: -*- Fundamental -*- */
  2. /*
  3.    Lexical analyzer for Dylan interm report tokens
  4.  
  5.    This software is free software; you can redistribute it and/or
  6.    modify it under the terms of the GNU Library General Public
  7.    License as published by the Free Software Foundation; either
  8.    version 2 of the License, or (at your option) any later version.
  9.  
  10.    This software is distributed in the hope that it will be useful,
  11.    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13.    Library General Public License for more details.
  14.  
  15.    You should have received a copy of the GNU Library General Public
  16.    License along with this software; if not, write to the Free
  17.    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  
  19.    Original copyright notice follows:
  20.  
  21.    Copyright 1994, Joseph N. Wilson.  All Rights Reserved.
  22.    Permission to use, copy, and modify this software and its
  23.    documentation is hereby granted only under the following terms and
  24.    conditions.  Both the above copyright notice and this permission
  25.    notice must appear in all copies of the software, derivative works
  26.    or modified version, and both notices must appear in supporting
  27.    documentation.  Users of this software agree to the terms and
  28.    conditions set forth in this notice.
  29.  
  30.  */
  31.  
  32. #ifdef sun
  33. #include <floatingpoint.h>
  34. #endif
  35.  
  36. #if defined(MACOS)
  37. #include <unix.h>
  38. #else
  39. #include <sys/types.h>
  40. #include <sys/time.h>
  41. #endif
  42.  
  43. #include <string.h>
  44.  
  45. #include "alloc.h"
  46. #include "bytestring.h"
  47. #include "character.h"
  48. #include "dylan.tab.h"
  49. #include "globaldefs.h"
  50. #include "list.h"
  51. #include "number.h"
  52. #include "object.h"
  53. #include "symbol.h"
  54. #include "yystype.h"
  55.  
  56. #ifdef BIG_INTEGERS
  57. #include "biginteger.h"
  58. #endif
  59.  
  60. extern char* prompt_continuation;
  61. extern int yyerrflag;
  62. extern int yydebug;
  63. extern int load_file_context;
  64.  
  65. int yylineno = 1;
  66.  
  67. int charready (FILE *stream);
  68. int strcasecmp (const char *s1, const char *s2);
  69.  
  70. Object header_key;
  71. Object header_val;
  72.  
  73. /* reserved struct and tables */
  74.  
  75. struct resword
  76. {
  77.     char *word;
  78.     int token;
  79.     Object *symbol;
  80. };
  81.  
  82. #define NUM_COREWORDS 8
  83.  
  84. struct resword coreword_table [NUM_COREWORDS] =
  85. {    
  86.     {"define", DEFINE, &define_symbol},
  87.     {"end", END, &end_symbol},
  88.     {"generic", GENERIC, &generic_symbol},
  89.     {"handler", HANDLER, &handler_symbol},
  90.     {"let", LET, &let_symbol},
  91.     {"local", LOCAL, &local_symbol},
  92.     {"method", METHOD, &method_symbol},
  93.     {"otherwise", OTHERWISE, &otherwise_symbol},
  94. };
  95.  
  96. #define NUM_BEGIN_WORDS    9
  97.  
  98. struct resword begin_word_table [NUM_BEGIN_WORDS] =
  99. {
  100.     {"begin", BEGIN_TOKEN, &begin_symbol},
  101.     {"block", BLOCK, &block_symbol},
  102.     {"case", CASE, &case_symbol},
  103.     {"for", FOR, &for_symbol},
  104.     {"if", IF, &if_symbol},
  105.     {"select", SELECT, &select_symbol},
  106.     {"unless", UNLESS, &unless_symbol},
  107.     {"until", UNTIL, &until_symbol},
  108.     {"while", WHILE, &while_symbol},
  109. };
  110.  
  111. #define NUM_DEFINING_WORDS    6
  112.  
  113. struct resword defining_word_table [NUM_DEFINING_WORDS] =
  114. {
  115.     {"class", CLASS, &class_symbol},
  116.     {"constant", CONSTANT, &constant_symbol},
  117.     {"library", LIBRARY, &library_symbol},
  118.     {"module", MODULE, &module_symbol},    
  119.     {"test", TEST, &test_symbol},
  120.     {"variable", VARIABLE, &variable_symbol},
  121. };
  122.  
  123.  
  124. /* intermediate word struct and tables */
  125.  
  126. struct intermediate_word_struct {
  127.     int num_words;
  128.     struct resword *reswords;
  129.     struct intermediate_word_struct *next;
  130.     
  131. }
  132. *intermediate_words;
  133.  
  134. #define NUM_IF_INTERMEDIATE_WORDS    2
  135. struct resword if_intermediate_word_table [NUM_IF_INTERMEDIATE_WORDS] =
  136. {
  137.     {"else", ELSE, &else_symbol},
  138.     {"elseif", ELSEIF, &elseif_symbol},
  139. };
  140.  
  141. #define NUM_SELECT_INTERMEDIATE_WORDS    1
  142. struct resword select_intermediate_word_table [NUM_SELECT_INTERMEDIATE_WORDS] =
  143. {
  144.     {"by", BY, &by_symbol},
  145. };
  146.  
  147. #define NUM_CLASS_INTERMEDIATE_WORDS    1
  148. struct resword class_intermediate_word_table [NUM_CLASS_INTERMEDIATE_WORDS] =
  149. {
  150.     {"slot", SLOT, &slot_symbol},
  151. };
  152.  
  153. #define NUM_FOR_INTERMEDIATE_WORDS    1
  154. struct resword for_intermediate_word_table [NUM_FOR_INTERMEDIATE_WORDS] =
  155. {
  156.     {"finally", FINALLY, &finally_symbol},
  157. };
  158.  
  159. #define NUM_FOR_CLAUSE_WORDS        7
  160. struct resword for_clause_word_table [NUM_FOR_CLAUSE_WORDS] =
  161. {
  162.     {"then", THEN, &then_symbol},
  163.     {"in", IN, &in_symbol},
  164.     {"from", FROM, &from_symbol},
  165.     {"to", TO, &to_symbol},
  166.     {"above", ABOVE, &above_symbol},
  167.     {"below", BELOW, &below_symbol},
  168.     {"by", BY, &by_symbol},
  169. };
  170.  
  171. #define NUM_BLOCK_INTERMEDIATE_WORDS    2
  172. struct resword block_intermediate_word_table [NUM_BLOCK_INTERMEDIATE_WORDS] =
  173. {
  174.     {"cleanup", CLEANUP, &cleanup_symbol},
  175.     {"exception", EXCEPTION, &exception_symbol},
  176. };
  177.  
  178. #define NUM_MODULE_INTERMEDIATE_WORDS    3
  179. struct resword module_intermediate_word_table [NUM_MODULE_INTERMEDIATE_WORDS] =
  180. {
  181.     {"use", USE, &use_symbol},
  182.     {"export", EXPORT, &export_symbol},
  183.     {"create", CREATE, &create_symbol},
  184. };
  185.  
  186. /*  */
  187.  
  188. extern Object yylval;
  189. int search_for_poundword (char *string, YYSTYPE *obj_ptr);
  190. int symbol_or_resword (char *string, YYSTYPE *obj_ptr);
  191. static struct resword *search_for_resword (char *string,
  192.                        struct resword *resword_table,
  193.                        int num_ords);
  194. int resword_compare (struct resword *c1, struct resword *c2);
  195.  
  196. static struct resword *search_intermediate_word (char *string);
  197.  
  198. int process_unrecognized_character (char *yytext);
  199. int which_operator (char *string, int length);
  200. void push_intermediate_words (Object begin_word);
  201. void pop_intermediate_words (void);
  202.  
  203. void make_header_key (void);
  204. void make_header_end (void);
  205. void make_header_val (void);
  206.  
  207. char *get_nonws_symbol (char *text);
  208. char expand_escaped_character (char ch);
  209. char* make_expanded_byte_string (char *str);
  210.  
  211. static int countlines(char *str);
  212. %}
  213. %pointer
  214.  
  215. EXP        ([Ee][\+\-]?[0-9][0-9]*)?
  216. anyCHAR        [a-zA-Z0-9\!&\*\<=\>\|\^\$%@_\-\+~\?\/]
  217. alphaCHAR    [a-zA-Z]
  218. leadALPHA    [a-zA-Z]{anyCHAR}*
  219. leadNUMERIC    [0-9]{anyCHAR}*
  220. leadGRAPHIC    [!&\*<=>\|\^\$%@_]{anyCHAR}*
  221. OPSYMS        [-~\+\*\/\^=\<\>&\|]|([\<\>=:~]=)
  222. SYMBOL        {leadALPHA}|({leadNUMERIC}[a-zA-Z]{leadALPHA})|([!&\*<=>\|\^\$%@_]{anyCHAR}*{leadALPHA})
  223. STRING        \"([^\\\"]|(\\(.|\n)))*\"
  224.  
  225. %x INI KEY VAL ETC
  226. /* start contexts courtesy of Roger Critchlow */
  227.  
  228. %%
  229.  
  230. <INITIAL>.    { BEGIN(INI);
  231.           yyless(0);
  232.         }
  233.  
  234. <INITIAL,INI,KEY,VAL,ETC><<EOF>>    { yylval = eof_object;
  235.                       return EOF_TOKEN;
  236.                     }
  237.  
  238. <INI>.        { BEGIN(ETC);
  239.           yyless(0);
  240.         }
  241.  
  242. <INI>^#!.*\n    { BEGIN(KEY);
  243.           /* warn(line_count, "ignoring initial #! interpreter comment\n"); */
  244.           /* line_count++; */
  245.           ++yylineno;
  246.         }
  247.  
  248. <INI,KEY>^[A-Za-z][-A-Za-z0-9]*:    { BEGIN(VAL);
  249.                   make_header_key();
  250.                   return yylex();
  251.                 }
  252.  
  253. <INI,KEY>^[\ \t\f]*\n    { BEGIN(ETC);
  254.               ++yylineno;
  255.               make_header_end ();
  256.               return yylex ();
  257.             }
  258.  
  259. <VAL>.*\n([\ \t\f]+.+\n)*    { BEGIN(KEY);
  260.                   yylineno += countlines (yytext);
  261.                   make_header_val ();
  262.                   return yylex ();
  263.                 }
  264.  
  265. <ETC>[\ \t\f]    { }
  266.  
  267. <ETC>[\n]    { /* Bogus hack! */
  268.           ++yylineno;
  269.           if (yyerrflag == 3) {
  270.               return ';';
  271.           } else if (! load_file_context) {
  272.               /* <pcb> not if loading from a file! */
  273.               if (! charready(yyin)) {
  274.               printf(prompt_continuation);
  275.               fflush (stdout); 
  276.               }
  277.           }
  278.         }
  279.  
  280. <ETC>#b[01][01]*    { /* binary integer */ 
  281.           yylval = make_integer (strtol (yytext+2, NULL, 2));
  282.           return (LITERAL);
  283.         }
  284.  
  285. <ETC>#o[0-7][0-7]*    { /* octal-integer */
  286.           yylval = make_integer (strtol (yytext+2, NULL, 8));
  287.           return (LITERAL);
  288.         }
  289.  
  290. <ETC>[+-]?[0-9][0-9]*    { /* decimal integer */
  291. #ifdef BIG_INTEGERS
  292.             if (strlen(yytext) >= 10)
  293.                 yylval = make_big_integer_str(yytext, 10);
  294.             else
  295.                 yylval = make_integer (strtol (yytext, NULL, 10));
  296. #else
  297.               yylval = make_integer (strtol (yytext, NULL, 10));
  298. #endif
  299.           return (LITERAL);
  300.         }
  301.  
  302. <ETC>#x[0-9A-Fa-f][0-9A-Fa-f]* { /* hex-integer */
  303.                 yylval = make_integer (strtol (yytext+2, NULL, 16));
  304.                 return (LITERAL);
  305.               }
  306.  
  307. <ETC>[+-]?[0-9][0-9]*\/[0-9][0-9]*    { /* ratio */ 
  308.                   char *ptr;
  309.                   long numerator, denominator;
  310.                   numerator = strtol (yytext, &ptr, 10);
  311.                   denominator = strtol (ptr + 1, NULL, 10);
  312.                   yylval = make_ratio (numerator, denominator);
  313.                   return (LITERAL);
  314.                 }
  315.  
  316. <ETC>[+-]?[0-9]*\.[0-9][0-9]*{EXP}    { yylval = make_dfloat (strtod (yytext, NULL));
  317.                       return (LITERAL);
  318.                     }
  319. <ETC>[+-]?[0-9][0-9]*\.[0-9]*{EXP}    { yylval = make_dfloat (strtod (yytext, NULL));
  320.                   return (LITERAL);
  321.                 }
  322. <ETC>[+-]?[0-9][0-9]*{EXP}    { yylval = make_dfloat (strtod (yytext, NULL));
  323.                   return (LITERAL);
  324.                 }
  325.  
  326. <ETC>\'([^\\\']|(\\.))\' { char ch = yytext [yyleng-2];
  327.                yylval =
  328.                 make_character(yytext[1] == '\\' ?
  329.                        expand_escaped_character(ch) : ch );
  330.                return (LITERAL);
  331.              }
  332.  
  333.  
  334. <ETC>{OPSYMS}        { /* OPERATOR  SYMBOL */ 
  335.               return which_operator(yytext, yyleng);
  336.             }
  337.  
  338. <ETC>[\(\)\[\]\{\}\.\,\;\~\?]    { /* return char as token */
  339.                   yylval = (Object)0;
  340.                   return *yytext;
  341.                 }
  342.  
  343. <ETC>=>        { yylval = equal_arrow_symbol;
  344.           return (EQUAL_ARROW);
  345.         }
  346.  
  347. <ETC>::        { yylval = colon_colon_symbol;
  348.           return (COLON_COLON);
  349.          }
  350.  
  351. <ETC>#\(        { yylval = NULL;
  352.           return (HASH_PAREN);
  353.          }
  354.  
  355. <ETC>#\[        { yylval = NULL;
  356.           return (HASH_BRACKET);
  357.          }
  358.  
  359. <ETC>\?\?        { yylval = NULL;
  360.           return (QUESTION_QUESTION);
  361.          }
  362.  
  363. <ETC>\.\.\.        { yylval = NULL;
  364.           return (ELLIPSIS);
  365.          }
  366.  
  367. <ETC>#{STRING}    { /* Do some nasty business with yytext */
  368.           yytext[yyleng-1] = ':';
  369.           yylval = make_keyword (yytext + 2);
  370.           return (KEYWORD);
  371.         }
  372.  
  373. <ETC>{SYMBOL}:    {
  374.           yylval = make_keyword (yytext);
  375.           if (yydebug) {
  376.             printf("yydebug: got symbol [%s]\n",  yytext);
  377.             }
  378.           return (KEYWORD);
  379.          }
  380.  
  381. <ETC>#[a-zA-Z][a-zA-Z\-]*    { return search_for_poundword (yytext, &yylval);
  382.             }
  383.  
  384.  
  385. <ETC>{SYMBOL}    { int tmp = symbol_or_resword (yytext, &yylval);
  386.           if (yydebug && tmp == SYMBOL) {
  387.             printf ("yydebug: got symbol [%s]\n", yytext);
  388.             }
  389.           return tmp;
  390.         }
  391.  
  392. <ETC>\\{OPSYMS}    { which_operator (yytext+1, yyleng-1);
  393.           return SYMBOL;
  394.         }
  395.  
  396. <INI,KEY,VAL,ETC>.    { process_unrecognized_character (yytext);
  397.             }
  398.  
  399. <ETC>\/\/[^\n]*    { }
  400.  
  401. <ETC>"/*"    { int ch;
  402.           loop:
  403.             do {
  404.                 ch = input();
  405.                 if (ch == '\n')
  406.                     ++yylineno;
  407.                 else
  408.                 if (ch == EOF)
  409.                     break;
  410.             } while (ch != '*');
  411.           inner:
  412.                   switch (input()) {
  413.             case EOF:
  414.             case '/': break;
  415.             case '*': goto inner;
  416.             case '\n': ++yylineno;
  417.             default: goto loop;
  418.               }
  419.         }
  420.  
  421. <ETC>{STRING}    { yytext[yyleng-1] = '\0';
  422.           yylval = make_expanded_byte_string (yytext+1);
  423.           return (STRING);
  424.         }
  425.  
  426. %%
  427. int yywrap() { return 1; }
  428.  
  429. int
  430. search_for_poundword (char *string, YYSTYPE *obj_ptr)
  431. {
  432.     switch (string[1]) {
  433.     case 't':
  434.     case 'T':
  435.     if (yyleng == 2) {
  436.         *obj_ptr = true_object;
  437.         return HASH_T;
  438.     }
  439.     break;
  440.     case 'f':
  441.     case 'F':
  442.     if (yyleng == 2) {
  443.         *obj_ptr = false_object;
  444.         return HASH_F;
  445.     }
  446.     break;
  447.     case 'n':
  448.     case 'N':
  449.     if (strcasecmp (string, "#next") == 0) {
  450.         *obj_ptr = next_symbol;
  451.         return HASH_NEXT;
  452.     }
  453.     break;
  454.     case 'r':
  455.     case 'R':
  456.     if (strcasecmp (string, "#rest") == 0) {
  457.         *obj_ptr = hash_rest_symbol;
  458.         return HASH_REST;
  459.     }
  460.     break;
  461.     
  462.     case 'k':
  463.     case 'K':
  464.     if (strcasecmp (string, "#key") == 0) {
  465.         *obj_ptr = key_symbol;
  466.         return HASH_KEY;
  467.     }
  468.     break;
  469.     case 'a':
  470.     case 'A':
  471.     if (strcasecmp (string, "#all-keys") == 0) {
  472.         *obj_ptr = allkeys_symbol;
  473.         return HASH_ALL_KEYS;
  474.     }
  475.     break;
  476.     }
  477.     obj_ptr = NULL;
  478.     return UNRECOGNIZED;
  479. }
  480.  
  481. int
  482. symbol_or_resword (char *string, YYSTYPE *obj_ptr)
  483. {
  484.     struct resword *result, target;
  485.  
  486.     target.word = string;
  487.  
  488.     result = search_for_resword (string, coreword_table, NUM_COREWORDS);
  489.     if (result) {
  490.     *obj_ptr = *(result->symbol);
  491.     return result->token;
  492.     }
  493.     /*     Check for simple begin word */
  494.     result = search_for_resword (string, begin_word_table, NUM_BEGIN_WORDS);
  495.     if (result) {
  496.     *obj_ptr = *(result->symbol);
  497.     return result->token;
  498.     }
  499.     result = search_intermediate_word (string);
  500.     if (result) {
  501.     *obj_ptr = *(result->symbol);
  502.     return result->token;
  503.     }
  504.     result = search_for_resword (string, defining_word_table,
  505.                  NUM_DEFINING_WORDS);
  506.     if (result) {
  507.     *obj_ptr = *(result->symbol);
  508.     return result->token;
  509.     }
  510.     *obj_ptr = make_symbol(string);
  511.     return SYMBOL;
  512. }
  513.  
  514. static struct resword *
  515. search_for_resword(char *string, struct resword *table, int num_words)
  516. {
  517.     struct resword target;
  518.  
  519.     target.word = string;
  520.     return (struct resword *)bsearch ((const void *)(&target),
  521.         (const void *) table,
  522.         num_words, sizeof (struct resword),
  523.             (int (*)(const void *, const void *))resword_compare);
  524. }
  525.  
  526. static struct resword *
  527. search_intermediate_word (char *string)
  528. {
  529.     Object tmp, sym;
  530.     int i;
  531.  
  532.     if (intermediate_words) {
  533.     for (i = 0; i < intermediate_words->num_words; i++) {
  534.         if (0 == strcasecmp(string,
  535.                 (intermediate_words->reswords)[i].word)) {
  536.         return &((intermediate_words->reswords)[i]);
  537.         }
  538.     }
  539.     }
  540.     return NULL;
  541. }
  542.  
  543. int
  544. resword_compare (struct resword *r1, struct resword *r2)
  545. {
  546.     return strcasecmp (r1->word, r2->word);
  547. }
  548.  
  549. int
  550. process_unrecognized_character (char *yytext)
  551. {
  552.     unsigned c = *yytext;
  553.     fprintf(stderr, "Unrecognized character '%c' (0x%02x).\n", c, c);
  554. }
  555.  
  556. void
  557. init_reserved_word_symbols (void)
  558. {
  559.     int i;
  560.  
  561.     intermediate_words = NULL;
  562.  
  563.     for (i = 0; i < NUM_COREWORDS; i++) {
  564.     *(coreword_table[i].symbol) = make_symbol(coreword_table[i].word);
  565.     }
  566.     for (i = 0; i < NUM_BEGIN_WORDS; i++) {
  567.     *(begin_word_table[i].symbol) =
  568.         make_symbol (begin_word_table[i].word);
  569.     }
  570.     for (i = 0; i < NUM_DEFINING_WORDS; i++) {
  571.     *(defining_word_table[i].symbol) =
  572.         make_symbol (defining_word_table[i].word);
  573.     }
  574.     for (i = 0; i < NUM_IF_INTERMEDIATE_WORDS; i++) {
  575.     *(if_intermediate_word_table[i].symbol) =
  576.         make_symbol (if_intermediate_word_table[i].word);
  577.     }
  578.     for (i = 0; i < NUM_SELECT_INTERMEDIATE_WORDS; i++) {
  579.     *(select_intermediate_word_table[i].symbol) =
  580.         make_symbol (select_intermediate_word_table[i].word);
  581.     } 
  582.     for (i = 0; i < NUM_CLASS_INTERMEDIATE_WORDS; i++) {
  583.     *(class_intermediate_word_table[i].symbol) =
  584.         make_symbol (class_intermediate_word_table[i].word);
  585.     } 
  586.     for (i = 0; i < NUM_FOR_INTERMEDIATE_WORDS; i++) {
  587.     *(for_intermediate_word_table[i].symbol) =
  588.         make_symbol (for_intermediate_word_table[i].word);
  589.     } 
  590.     for (i = 0; i < NUM_FOR_CLAUSE_WORDS; i++) {
  591.     *(for_clause_word_table[i].symbol) =
  592.         make_symbol (for_clause_word_table[i].word);
  593.     }
  594.    for (i = 0; i < NUM_BLOCK_INTERMEDIATE_WORDS; i++) {
  595.     *(block_intermediate_word_table[i].symbol) =
  596.         make_symbol (block_intermediate_word_table[i].word);
  597.     }
  598.    for (i = 0; i < NUM_MODULE_INTERMEDIATE_WORDS; i++) {
  599.     *(module_intermediate_word_table[i].symbol) =
  600.         make_symbol (module_intermediate_word_table[i].word);
  601.     }
  602.     equal_arrow_symbol = make_symbol("=>");    
  603.     colon_colon_symbol = make_symbol("::");
  604. }
  605.  
  606. int
  607. which_operator( char *string, int length)
  608. {
  609.     if (length == 1) {
  610.     switch (*string) {
  611.     case '+':
  612.         yylval = plus_symbol;
  613.         break;
  614.     case '-':
  615.         yylval = minus_symbol;
  616.         break;
  617.     case '*':
  618.         yylval = times_symbol;
  619.         break;
  620.     case '/':
  621.         yylval = divides_symbol;
  622.         break;
  623.     case '^':
  624.         yylval = exponent_symbol;
  625.         break;
  626.     case '<':
  627.         yylval = lesser_symbol;
  628.         break;
  629.     case '>':
  630.         yylval = greater_symbol;
  631.         break;
  632.     case '=':
  633.         yylval = equal_symbol;
  634.         break;
  635.     case '&':
  636.         yylval = and_symbol;
  637.         break;
  638.     case '|':
  639.         yylval = or_symbol;
  640.         break;
  641.     case '~':
  642.         yylval = not_symbol;
  643.         break;
  644.     }
  645.     return *string;
  646.     } else {
  647.     switch (*string) {
  648.     case '<':
  649.         yylval = lesser_equal_symbol;
  650.         return LESSER_EQUAL;
  651.     case '>':
  652.         yylval = greater_equal_symbol;
  653.         return GREATER_EQUAL;
  654.     case '=':
  655.         yylval = equal_equal_symbol;
  656.         return EQUAL_EQUAL;
  657.     case '~':
  658.         yylval = not_equal_symbol;
  659.         return NOT_EQUAL;
  660.     case ':':
  661.         yylval = colon_equal_symbol;
  662.         return COLON_EQUAL;
  663.     }
  664.     }
  665. }
  666.  
  667. void
  668. push_intermediate_words(Object begin_word)
  669. {
  670.     struct intermediate_word_struct *new_table;
  671.  
  672.     new_table = (struct intermediate_word_struct *)
  673.     checking_malloc (sizeof (struct intermediate_word_struct));
  674.  
  675.     if (begin_word == if_symbol) {
  676.     new_table->num_words = NUM_IF_INTERMEDIATE_WORDS;
  677.     new_table->reswords = if_intermediate_word_table;
  678.     } else if (begin_word == select_symbol) {
  679.     new_table->num_words = NUM_SELECT_INTERMEDIATE_WORDS;
  680.     new_table->reswords = select_intermediate_word_table;
  681.     } else if(begin_word == class_symbol) {
  682.     new_table->num_words = NUM_CLASS_INTERMEDIATE_WORDS;
  683.     new_table->reswords = class_intermediate_word_table;
  684.     } else if (begin_word == for_symbol) {
  685.     new_table->num_words = NUM_FOR_INTERMEDIATE_WORDS;
  686.     new_table->reswords = for_intermediate_word_table;
  687.     new_table->next = intermediate_words;
  688.     intermediate_words = new_table;
  689.     new_table = (struct intermediate_word_struct *)
  690.         checking_malloc (sizeof (struct intermediate_word_struct));
  691.     new_table->num_words = NUM_FOR_CLAUSE_WORDS;
  692.     new_table->reswords = for_clause_word_table;
  693.     } else if (begin_word == block_symbol) {
  694.     new_table->num_words = NUM_BLOCK_INTERMEDIATE_WORDS;
  695.     new_table->reswords = block_intermediate_word_table;
  696.     } else if (begin_word == module_symbol) {
  697.     new_table->num_words = NUM_MODULE_INTERMEDIATE_WORDS;
  698.     new_table->reswords = module_intermediate_word_table;
  699.     }
  700.     new_table->next = intermediate_words;
  701.     intermediate_words = new_table;
  702. }
  703.  
  704. void
  705. pop_intermediate_words()
  706. {
  707.     intermediate_words = intermediate_words->next;
  708. }
  709.  
  710. void
  711. make_header_key()
  712. {
  713.     header_key = make_keyword (yytext);
  714. }
  715.  
  716. void
  717. make_header_end()
  718. {
  719.  
  720. }
  721.  
  722. char *
  723. get_nonws_symbol (char *text)
  724. {
  725.     char *buffer, *buf_ptr, *start_ptr, *end_ptr;
  726.  
  727.     for (start_ptr = text;
  728.          *start_ptr == ' ' || *start_ptr == '\t';
  729.          start_ptr++);
  730.     for (end_ptr = start_ptr;
  731.          *end_ptr != ' ' && *end_ptr != '\t' && *end_ptr != '\n';
  732.              end_ptr++);
  733.     buf_ptr = buffer =
  734.         (char *) checking_malloc((end_ptr - start_ptr + 1) * sizeof (char));
  735.     for(; start_ptr < end_ptr; *buf_ptr++ = *start_ptr++);
  736.     *buf_ptr = '\0';
  737.     return buffer;
  738. }
  739.  
  740. void
  741. make_header_val()
  742. {
  743.     char *ptr, *zero_ptr;
  744.  
  745.  
  746.     if (header_key == module_keyword) {
  747.         set_module (module_binding
  748.                 (make_symbol (get_nonws_symbol (yytext))));
  749.     }
  750. }
  751.  
  752. int
  753. charready (FILE *stream)
  754. {
  755. #ifdef MACOS
  756.     return ((stdin)->cnt > 0);
  757. #else
  758.     fd_set  readfds;
  759.     int  nfound;
  760.     struct timeval  timeout;
  761.  
  762.     if (yylval == eof_object) {
  763.     /* This horrible kludge makes a prompt print after a file load */
  764.         return 0;
  765.     }
  766. #ifdef __linux__
  767.     if  (stream->_IO_read_end >= stream->_IO_read_ptr) {
  768. #else
  769.     if  (((stream)->_cnt) <= 0)  {
  770. #endif
  771.     FD_ZERO( &readfds );
  772.     FD_SET( fileno( stream ), &readfds );
  773.     timeout.tv_sec = 0;
  774.     timeout.tv_usec = 300000;
  775.     nfound = select( fileno( stream )+1, &readfds, 0, 0, &timeout );
  776.     if  (nfound <= 0)  {
  777.         return 0;
  778.     }
  779.     }
  780.     return 1;
  781. #endif
  782. }
  783.  
  784. void
  785. yy_skip_ws()
  786. {
  787.     int c = '\0';
  788.  
  789.     while (charready (yyin) &&    
  790.        ((c = input()) == ' ' || c == '\t' || c == '\n')){
  791.     }
  792.     if (c && c != '\n') {
  793.     unput(c);
  794.     }
  795. }
  796.  
  797. void
  798. yy_restart(FILE *new_file)
  799. {
  800.     yylineno = 1;
  801.     yyrestart(new_file);
  802.     BEGIN(INI);
  803. }
  804.  
  805. char
  806. expand_escaped_character (char ch)
  807. {
  808.     switch (ch) {
  809.     case 'b':
  810.         return '\b';
  811.     case 'f':
  812.         return '\f';
  813.     case 'n':
  814.         return '\n';
  815.     case 'r':
  816.         return '\r';
  817.     case 't':
  818.         return '\t';
  819.     }
  820.     return ch;
  821. }
  822.  
  823. char* make_expanded_byte_string(char* str)
  824. {
  825.     char* backslash = strchr(str, '\\');
  826.     if (backslash) {
  827.         char* exp_str;
  828.         Object obj;
  829.         
  830.         exp_str = checking_strdup (str);
  831.         exp_str[0] = '\0';
  832.         while (backslash) {
  833.             backslash[0] = expand_escaped_character(backslash[1]);
  834.             backslash[1] = '\0';
  835.             strcat(exp_str, str);
  836.             str = backslash + 2;
  837.             backslash = strchr(str, '\\');
  838.         }
  839.         strcat(exp_str, str);
  840.  
  841.         obj = allocate_object (sizeof (struct byte_string));    
  842.         BYTESTRTYPE (obj) = ByteString;
  843.         BYTESTRSIZE(obj) = strlen (exp_str);
  844.         BYTESTRVAL(obj) = exp_str;
  845.         return (obj);
  846.     }
  847.     return make_byte_string(str);
  848. }
  849.  
  850. static int countlines(char *str)
  851. {
  852.     int lines = 0;
  853.     char c = *str++;
  854.     while (c) {
  855.         if (c == '\n') ++lines;
  856.         c = *str++;
  857.     }
  858.     return lines;
  859. }
  860.